home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0014_VOCPLAY.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  5KB  |  252 lines

  1. {
  2. > Does anybody know where to get some good source that plays Vocs?
  3. }
  4.  
  5. {$A+,B-,D+,E-,F+,G-,I-,L-,N-,O+,R-,S-,V-,X-}
  6. {$M   1024,0,0 }
  7. Unit  VOCPlay;
  8.  
  9. Interface
  10.  
  11. Uses
  12.   Dos;
  13.  
  14. Var
  15.   VoiceStatusWord           : Word;
  16.   VocPaused,VOCDrvInstalled : Boolean;
  17.  
  18. Procedure AllocateMem(Var P : Pointer;Size : LongInt);
  19. Function  AllocateMemFunc(Var P : Pointer;Size : LongInt) : Boolean;
  20. Function  ReAllocateMem(Var P : Pointer;NewSize : LongInt) : Boolean;
  21. Procedure DisAllocateMem(Var P : Pointer);
  22.  
  23. Procedure VocOutPut(AdrtoPlay : Pointer);
  24. Procedure VocStop;
  25. Procedure VocPause;
  26. Procedure VocContinue;
  27. Procedure VocSetSpeaker(Onoff : Boolean);
  28. Function  VocInitDriver : Byte;
  29. Function  LoadVoctoMem(DateiName : String;Var VocMem : Pointer) : Boolean;
  30.  
  31. Implementation
  32. Const
  33.   VocDriverHeader         = 12;
  34.   VocFileHeaderLen        = $1A;
  35. Var
  36.   PtrtoDriver,OldExitProc : Pointer;
  37.   Regs                    : Registers;
  38.   SizeIntern              : Word;
  39.  
  40. Procedure AllocateMem;
  41. begin
  42.   Inc(Size,15);
  43.   SizeIntern := (Size SHR 4);
  44.   Regs.AH    := $48;
  45.   Regs.BX    := SizeIntern;
  46.   MsDos(Regs);
  47.   if Regs.Flags and FCarry <> 0 then
  48.     P := NIL
  49.   else
  50.     P := Ptr(Regs.AX,0);
  51. end;
  52.  
  53. Function AllocateMemFunc;
  54. begin
  55.   AllocateMem(P,Size);
  56.   AllocateMemFunc := P <> NIL;
  57. end;
  58.  
  59. Function ReAllocateMem;
  60. begin
  61.   Inc(NewSize,15);
  62.   SizeIntern    := (NewSize SHR 4);
  63.   Regs.AH       := $4A;
  64.   Regs.BX       := SizeIntern;
  65.   Regs.ES       := Seg(P^);
  66.   MsDos(Regs);
  67.   ReAllocateMem := (Regs.BX=SizeIntern);
  68. end;
  69.  
  70. Procedure DisAllocateMem;
  71. begin
  72.   Regs.AH := $49;
  73.   Regs.ES := Seg(P^);
  74.   MsDos(Regs);
  75. end;
  76.  
  77. Function Exists(FileName : String) : Boolean;
  78. Var
  79.   S : SearchRec;
  80. begin
  81.   FindFirst(FileName,AnyFile,S);
  82.   Exists := (DosError=0);
  83. end;
  84.  
  85. Function VocInitDriver;
  86. Const
  87.   DriverName = 'CT-VOICE.DRV';
  88. Type
  89.   DriverType = Array [0..VocDriverHeader] of Char;
  90. Var
  91.   Out,S,O    : Word;
  92.   F          : File;
  93. begin
  94.   Out := 0;
  95.   if not Exists(DriverName) then
  96.  begin
  97.    VocInitDriver := 4;
  98.    Exit;
  99.  end;
  100.   Assign(F,DriverName);
  101.   Reset(F,1);
  102.   if not AllocateMemFunc(PtrtoDriver,FileSize(F)) then Out := 5;
  103.   if Out=0 then BlockRead(F,PtrtoDriver^,FileSize(F));
  104.   Close(F);
  105.   if Out<>0 then
  106.  begin
  107.    VocInitDriver := Out;
  108.    Exit;
  109.  end;
  110.   if (DriverType(PtrtoDriver^)[3]<>'C') or
  111.      (DriverType(PtrtoDriver^)[4]<>'T') then
  112.  begin
  113.    VocInitDriver := 4;
  114.    Exit;
  115.  end;
  116.   S := Seg(VoiceStatusWord);
  117.   O := ofs(VoiceStatusWord);
  118.   Asm
  119.     mov   bx,3
  120.     call  PtrtoDriver
  121.     mov   Out,ax
  122.     mov   bx,5
  123.     mov   es,S
  124.     mov   di,O
  125.     call  PtrtoDriver
  126.   end;
  127.   VocInitDriver := Out;
  128. end;
  129.  
  130. Procedure VocUninstallDriver;
  131. begin
  132.   if VocDrvInstalled then
  133.   Asm
  134.     mov   bx,9
  135.     call  PtrtoDriver
  136.   end;
  137. end;
  138.  
  139. Procedure VocOutPut;
  140. Var
  141.   S,O : Word;
  142. begin
  143.   VocSetSpeaker(True);
  144.   S := Seg(AdrtoPlay^);
  145.   O := ofs(AdrtoPlay^)+VocFileHeaderLen;
  146.   Asm
  147.     mov   bx,6
  148.     mov   es,S
  149.     mov   di,O
  150.     call  PtrtoDriver
  151.   end;
  152. end;
  153.  
  154. Procedure VocStop;
  155. begin
  156.   Asm
  157.     mov   bx,8
  158.     call  PtrtoDriver
  159.   end;
  160. end;
  161.  
  162. Procedure VocPause;
  163. begin
  164.   Asm
  165.     mov   bx,10
  166.     call  PtrtoDriver
  167.   end;
  168. end;
  169.  
  170. Procedure VocContinue;
  171. begin
  172.   Asm
  173.     mov   bx,11
  174.     call  PtrtoDriver
  175.   end;
  176. end;
  177.  
  178. Procedure VocSetSpeaker;
  179. Var B : Byte;
  180. begin
  181.   B := ord(Onoff) and $01;
  182.   Asm
  183.     mov   bx,4
  184.     mov   al,B
  185.     call  PtrtoDriver
  186.   end;
  187. end;
  188.  
  189. Function LoadVoctoMem;
  190. Var F            : File;
  191.     Out          : Boolean;
  192.     Gelesen,Segs : Word;
  193. begin
  194.   Out := Exists(DateiName);
  195.   if Out then
  196.  begin
  197.    Assign(F,DateiName);Reset(F,1);
  198.    if not AllocateMemFunc(VocMem,FileSize(F)) then
  199.   begin
  200.     Close(F);
  201.     LoadVoctoMem := False;
  202.     Exit;
  203.   end;
  204.    Segs := 0;
  205.    Repeat
  206.      BlockRead(F,Ptr(Seg(VocMem^)+4096*Segs,ofs(VocMem^))^,$FFFF,Gelesen);
  207.      Inc(Segs);
  208.    Until Gelesen=0;
  209.    Close(F);
  210.  end;
  211.   LoadVoctoMem := Out;
  212. end;
  213.  
  214. {$F+}
  215. Procedure VocPlayExitProc;
  216. begin
  217.   VocUninstallDriver;
  218.   ExitProc := OldExitProc;
  219. end;
  220. {$F-}
  221.  
  222. begin
  223.   OldExitProc     := ExitProc;
  224.   ExitProc        := @VocPlayExitProc;
  225.   VoiceStatusWord := 0;
  226.   VocPaused       := False;
  227.   VocDrvInstalled := (VocInitDriver=0);
  228. end.
  229.  
  230.  
  231. {$A+,B-,D+,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  232. {$M   1024,0,0 }
  233. Uses  Crt,VOCPlay;
  234. Var   VocMem   : Pointer;
  235.       FileName : String;
  236.       Ok       : Boolean;
  237. begin
  238.   FileName := ParamStr(1);
  239.   Ok       := False;
  240.   if VocDrvInstalled then Ok := LoadVoctoMem(DateiName,VocMem);
  241.   if Ok then
  242.  begin
  243.    Write('Playing VOC-File ...');
  244.    VocOutPut(VocMem);
  245.    Repeat
  246.    Until (VoiceStatusWord=0) or KeyPressed;
  247.    Writeln;
  248.    DisAllocateMem(VocMem);
  249.  end
  250.  else Writeln('Hey, there was something wrong.');
  251. end.
  252.